home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Software Vault: The Gold Collection
/
Software Vault - The Gold Collection (American Databankers) (1993).ISO
/
cdr53
/
pctv4n_1.zip
/
CONCEN.TXT
< prev
next >
Wrap
Text File
|
1993-06-10
|
5KB
|
202 lines
' Listing 2 - Concen.Frm
Const MAX_MATCH = 20
Dim CrLf As String
Dim PiecesLoaded As Integer
Dim CurrentPlayer As Integer
Dim NumShown As Integer
Dim Piece1 As Integer
Dim Piece2 As Integer
Dim PlayingGame As Integer
Dim MatchesMade As Integer
Sub NewCmd_Click ()
ReDim TrackUsed(1 To 20) As Integer
Dim Selection As Integer, PicSelected As Integer
Dim i As Integer
' Initialize game variables
InitPlayerRecs
MousePointer = HOURGLASS
' Load the game pieces if not already done.
If Not PiecesLoaded% Then
For i% = 1 To 39
Load btnGamePiece(i%)
InitGamePiece btnGamePiece(i%)
Next i%
PiecesLoaded% = TRUE
End If
Piece1% = -1
Piece2% = -1
MatchesMade% = 0
PlayingGame = TRUE
' Shuffle the pieces
Randomize Timer
For i% = 0 To 39
PicSelected% = FALSE
Do
Selection% = Int(Rnd(1) * 20) + 1
If TrackUsed(Selection%) < 2 Then
PicSelected% = TRUE
TrackUsed(Selection%) = TrackUsed(Selection%) + 1
SetPic btnGamePiece(i%), Selection%
End If
Loop Until PicSelected%
Next i%
MousePointer = DEFAULT
MsgBox "Ready to start game.", MB_ICONINFORMATION, "New Game"
End Sub
Sub ExitCmd_Click ()
End
End Sub
Sub Form_Load ()
CrLf$ = Chr$(13) + Chr$(10) ' Initialize CrLf$
End Sub
Sub btnGamePiece_Click (Index As Integer)
Dim NewScore As Integer
If Index = Piece1% Then
btnGamePiece(Index).Frame = 2
btnGamePiece(Index).Value = 2
Exit Sub
End If
NumShown% = NumShown% + 1
If PlayingGame Then
Select Case NumShown%
Case 1
Piece1% = Index
Case 2
Piece2% = Index
If btnGamePiece(Piece1%).Tag = btnGamePiece(Piece2%).Tag Then
MessageBeep (MB_ICONINFORMATION)
MsgBox "You made a match!", MB_ICONINFORMATION, "A Match!"
btnGamePiece(Piece1%).Visible = FALSE
btnGamePiece(Piece2%).Visible = FALSE
NumShown% = 0
Piece1% = -1
Piece2% = -1
NewScore% = Players(CurrentPlayer).Score
NewScore% = NewScore% + 1
Players(CurrentPlayer).Score = NewScore%
PlayerScore(CurrentPlayer - 1).Caption = Str$(NewScore%)
MatchesMade% = MatchesMade% + 1
Else
Timer1.Interval = 3000 / Players(CurrentPlayer).Level
Timer1.Enabled = TRUE
End If
Case 3
btnGamePiece(Index).Value = 1
btnGamePiece(Index).Frame = 1
NumShown% = 2
End Select
Else
MsgBox "Start a new game first!", MB_ICONEXCLAMATION, "Error"
End If
If MatchesMade% >= MAX_MATCH Then
AnnounceWinner
End If
End Sub
Sub Timer1_Timer ()
btnGamePiece(Piece1%).Value = 1
btnGamePiece(Piece2%).Value = 1
NumShown% = 0
Piece1% = -1
Piece2% = -1
Timer1.Enabled = FALSE
If CurrentPlayer = 1 Then
PlayerName(0).BackColor = QBColor(15)
PlayerName(1).BackColor = QBColor(7)
CurrentPlayer = 2
Else
PlayerName(1).BackColor = QBColor(15)
PlayerName(0).BackColor = QBColor(7)
CurrentPlayer = 1
End If
End Sub
Sub AnnounceWinner ()
Dim Msg As String, Title As String
If Players(1).Score > Players(2).Score Then
Msg$ = Players(1).Name + " is the winner!"
Title$ = "Congratulations!"
ElseIf Players(1).Score < Players(2).Score Then
Msg$ = Players(2).Name + " is the winner!"
Title$ = "Congratulations!"
Else
Msg$ = "The game was tied!"
Title$ = "No Winner"
End If
MsgBox Msg$, MB_ICONEXCLAMATION, Title$
PlayingGame = FALSE
End Sub
Sub InitPlayerRecs ()
Dim i As Integer
For i% = 1 To 2
Players(i%).Level = 1
Next i%
PlayerInfoForm.Show MODAL
Unload PlayerInfoForm
CurrentPlayer = 1
For i% = 1 To 2
PlayerName(i% - 1).Caption = Players(i%).Name
Next i%
PlayerName(CurrentPlayer - 1).BackColor = QBColor(7)
End Sub
Sub SetPic (PicBox As Control, PicNum As Integer)
PicBox.Frame = 2
PicSet.Frame = PicNum%
PicBox.Picture = PicSet.Picture
PicBox.Tag = Str$(PicNum%)
PicBox.Frame = 1
PicBox.Value = 1
PicBox.Enabled = TRUE
PicBox.Visible = TRUE
End Sub
Sub InitGamePiece (Piece As Control)
Static X, Y
' Make sure x and y are only initialized the
' first time the Sub gets called.
If X = 0 Then
X = 720
Y = 120
End If
Piece.Left = X
Piece.Top = Y
' Piece.Picture = Source.Picture
X = X + 600
If X > 5520 Then
X = 120
Y = Y + 600
End If
End Sub
Sub AboutCmd_Click ()
AboutBox.Show MODAL
Unload AboutBox
End Sub
Sub Form_Unload (Cancel As Integer)
For i% = 1 To 39
Unload btnGamePiece(i%)
Next i%
End Sub